perm filename CEVAL[LSP,JRA] blob sn#205418 filedate 1976-03-05 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(DE EVAL*()
C00004 ENDMK
CāŠ—;
(DE EVAL*()
	(COND
	((IS_CONST EXP) (SETQ VAL (DENOTE EXP))(RESTORE))
	((IS_VAR EXP) (SETQ VAL (LOOKUP EXP ENV))(RESTORE))
	(T (SETQ FUN (FUN EXP)) (SETQ ARGS (ARGS EXP)) (SETQ PC @EVAL1))
)))))
(DE EVAL1 ()
	(COND
	((IS_EXPR FUN)(SETQ PC @EVALEXPR))
	((IS_FEXPR FUN) (COND( (PRIM_OP_FEXPR FUN)(JUMP_RESTORE_FEXPR FUN))
				(T (SETQ EXP (BODY FN))(SETQ ENV
							 (NEW_ENV (VARS FN)
								   ARGS
								   ENV))
							(SETQ PC @EVAL))
			))
	(T (SAVEUP @EVAL2)(SETQ EXP FUN)(SETQ PC @EVAL))
       )))))))

(DE EVALEXPR()
	(COND((NULL ARGS)(COND((PRIM_OP_EXPR FUN)(JUMP_RESTORE_EXPR FUN))
				(T(SETQ EXP(BODY FUN)) (SETQ ENV
							(NEW_ENV(VARS FUN)
								(SPREAD EARGS)
								ENV))
							(SETQ PC @EVAL))
				))
	(T (SAVEUP @EVALEXPR1)(SETQ EXP (FIRST ARGS))(SETQ PC @EVAL))
	))
)))))
(DE EVALEXPR1()
	(PROG()(PUSH VAL EARGS)(POP ARGS)(RETURN (SETQ PC @EVALEXPR))))
))
(DE EVAL2()(PROG()(SETQ FUN VAL)(RETURN (SETQ PC @EVAL1))))
))